#lang racket


(require "../global.rkt"
         "../base/main.rkt"
         "../backends/main.rkt")

(require "constructor-defer.rkt")

(provide
 ; evaluate
 evaluate
 evaluate-toplevel
 
 ; lang
 bbox
 par
 view!
 view-ortho-top!
 
 ; properties
 curve-begin-coord
 curve-end-coord
 
 surface-curvature
 surface-domain
 
 ; cad
 begin-undo-mark
 delete-shape
 delete-shapes
 end-undo-mark
 get-shapes
 render-shapes
 undo)


(define (current-out-evaluate expr)
  (backend-evaluate (current-out-backend) expr))

(define (current-out-evaluate-toplevel expr)
  (backend-evaluate-toplevel (current-out-backend) expr))


(define (current-in-fn fn)
  (fn (backend-proxy (current-in-backend))))

(define (current-out-fn fn)
  (fn (backend-proxy (current-out-backend))))

(define (warn-abort (exp (void)))
  (displayln "Warning: no backend selected; shapes will not be created")
  exp)


; evaluate

(define (evaluate expr)
  (if current-out-backend
      (current-out-evaluate expr)
      expr))

(define (evaluate-toplevel expr)
  (if current-out-backend
      (current-out-evaluate-toplevel expr)
      expr))


; lang

(define (bbox node)
  (if current-out-backend
      ((current-out-fn proxy-bbox) (evaluate-toplevel node))
      (warn-abort bbox-zero)))

(define (par node)
  (if current-out-backend
      ((current-out-fn proxy-par) (evaluate-toplevel node))
      (warn-abort)))

; edit: HACK! This is semantically incorrect, but it works because
; the view function does not really do anything to the shapes it
; receives as argument
(define (view! . args)
  (let* ((shapes (list))
         (node (apply view (append args (list shapes)))))
    (if current-out-backend
        (evaluate node)
        (warn-abort))))

; edit: HACK! see view!
(define (view-ortho-top! . args)
  (let* ((shapes (list))
         (node (apply view-ortho-top (append args (list shapes)))))
    (if current-out-backend
        (evaluate node)
        (warn-abort))))


; properties

(define (curve-begin-coord node)
  (if current-out-backend
      ((current-out-fn proxy-curve-begin-coord) (evaluate-toplevel node))
      (warn-abort u0)))

(define (curve-end-coord node)
  (if current-out-backend
      ((current-out-fn proxy-curve-end-coord) (evaluate-toplevel node))
      (warn-abort u0)))

(define (surface-curvature node)
  (if current-out-backend
      ((current-in-fn proxy-surface-curvature) (evaluate-toplevel node))
      (warn-abort)))

(define (surface-domain node)
  (if current-out-backend
      ((current-in-fn proxy-surface-domain) (evaluate-toplevel node))
      (warn-abort)))


; cad

(define (begin-undo-mark)
  (if current-out-backend
      ((current-out-fn proxy-begin-undo-mark))
      (warn-abort)))

(define (delete-shape shape)
  (if current-out-backend
      ((current-out-fn proxy-delete-shape) shape)
      (warn-abort)))

(define (delete-shapes)
  (if current-out-backend
      ((current-out-fn proxy-delete-shapes))
      (warn-abort)))

(define (end-undo-mark)
  (if current-out-backend
      ((current-out-fn proxy-end-undo-mark))
      (warn-abort)))

(define (get-shapes)
  (if current-out-backend
      ((current-out-fn proxy-get-shapes))
      (warn-abort (list))))

(define (render-shapes width height path)
  (if current-out-backend
      ((current-out-fn proxy-render-shape) width height path)
      (warn-abort)))

(define (undo)
  (if current-out-backend
      ((current-out-fn proxy-undo))
      (warn-abort)))